home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / megasort.zip / MEGASORT.LTG
Text File  |  1987-10-19  |  7KB  |  268 lines
  1. Megasort: A Distribution Sort
  2.  
  3. Listing 1
  4.  
  5.     1: PROGRAM megaa; {Copyright 1986 by Steve Heller, Inc.  All rights reserved.}
  6.     2: 
  7.     3: CONST
  8.     4:   MaxSize = 5000;
  9.     5: 
  10.     6: TYPE
  11.     7:   AnyString = String[255];
  12.     8:   SomeString = String[10];
  13.     9:   StrPtrArr = ARRAY [1..MaxSize] OF ^AnyString;
  14.    10:   SortArray = ARRAY [Char] OF Integer;
  15.    11: 
  16.    12: VAR
  17.    13:   TestArray : ^StrPtrArr;
  18.    14:   TestArray2 : ^StrPtrArr;
  19.    15:   TestArray3 : ^StrPtrArr;
  20.    16:   junk : AnyString;
  21.    17:   i : Integer;
  22.    18:   infile : text[10000];
  23.    19:   infilename : AnyString;
  24.    20:   outfile : text[10000];
  25.    21:   outfilename : AnyString;
  26.    22:   KeyLen : Integer;
  27.    23:   ArrayLength : Integer;
  28.    24: 
  29.    25: PROCEDURE Megasort(VAR PtrArray:StrPtrArr; VAR SubArray1:StrPtrArr;
  30.    26:                     VAR Subarray2:StrPtrArr;
  31.    27:                     ArrayCount:Integer;KeyLength:Integer;ArraySize:Integer);
  32.    28: 
  33.    29: VAR
  34.    30:   l : Char;
  35.    31:   m : Char;
  36.    32:   i : Integer;
  37.    33:   j : Integer;
  38.    34:   BucketCount  : SortArray;
  39.    35:   BucketPosition : SortArray;
  40.    36:   TempPtrArr : ^StrPtrArr;
  41.    37:   TempSubArr1: ^StrPtrArr;
  42.    38:   TempSubArr2: ^StrPtrArr;
  43.    39: 
  44.    40: 
  45.    41: BEGIN
  46.    42: 
  47.    43:   New(TempPtrArr);
  48.    44:   New(TempSubArr1);
  49.    45:   New(TempSubArr2);
  50.    46: 
  51.    47:   FOR i := KeyLength DOWNTO 1 DO
  52.    48:     BEGIN
  53.    49:       FOR l := #0 TO #255 DO
  54.    50:         BucketCount[l] := 0;
  55.    51:       FOR j := 1 TO ArraySize DOè   52:         BEGIN
  56.    53:           IF i > length(PtrArray[j]^) THEN
  57.    54:             m := #0
  58.    55:           ELSE
  59.    56:             m := PtrArray[j]^[i];
  60.    57:           BucketCount[m] := BucketCount[m] + 1;
  61.    58:         END;
  62.    59: 
  63.    60:       BucketPosition[#0] := 1;
  64.    61:       FOR l := #1 TO #255 DO
  65.    62:         BucketPosition[l] := BucketCount[pred(l)] + BucketPosition[pred(l)];
  66.    63: 
  67.    64:       FOR j := 1 TO ArraySize DO
  68.    65:         BEGIN
  69.    66:           IF i > length(PtrArray[j]^) THEN
  70.    67:             m := #0
  71.    68:           ELSE
  72.    69:             m := PtrArray[j]^[i];
  73.    70:           TempPtrArr^[BucketPosition[m]] := PtrArray[j];
  74.    71:           IF ArrayCount >=2 THEN
  75.    72:             TempSubArr1^[BucketPosition[m]] := SubArray1[j];
  76.    73:           IF ArrayCount =3 THEN
  77.    74:             TempSubArr2^[BucketPosition[m]] := SubArray2[j];
  78.    75:           BucketPosition[m] := BucketPosition[m] + 1;
  79.    76:         END;
  80.    77: 
  81.    78:       FOR j := 1 TO ArraySize DO
  82.    79:         BEGIN
  83.    80:           PtrArray[j] := TempPtrArr^[j];
  84.    81:           IF ArrayCount >=2 THEN
  85.    82:             SubArray1[j] := TempSubArr1^[j];
  86.    83:           IF ArrayCount = 3 THEN
  87.    84:             SubArray2[j] := TempSubArr2^[j];
  88.    85:         END;
  89.    86: 
  90.    87:     END;
  91.    88: 
  92.    89:     Dispose(TempPtrArr);
  93.    90:     Dispose(TempSubArr1);
  94.    91:     Dispose(TempSubArr2);
  95.    92: 
  96.    93:   END;
  97.    94: 
  98.    95: 
  99.    96: 
  100.    97: 
  101.    98: BEGIN
  102.    99:   New(TestArray);
  103.   100: 
  104.   101:   Write('Input file name: ');
  105.   102:   ReadLn(infilename);
  106.   103:   Write('Output file name: ');
  107.   104:   ReadLn(outfilename);
  108.   105:   Write('Key length: ');
  109.   106:   ReadLn(KeyLen);è  107:   Assign(infile,infilename);
  110.   108:   Reset(infile);
  111.   109:   Assign(outfile,outfilename);
  112.   110:   Rewrite(outfile);
  113.   111: 
  114.   112:   WriteLn('Reading input file.');
  115.   113: 
  116.   114:   i := 0;
  117.   115:   WHILE NOT EOF(infile) DO
  118.   116:     BEGIN
  119.   117:       i := i + 1;
  120.   118:       ReadLn(infile,junk);
  121.   119:       GetMem(TestArray^[i],length(junk)+1);
  122.   120:       TestArray^[i]^ := junk;
  123.   121:     END;
  124.   122: 
  125.   123:   ArrayLength := i;
  126.   124: 
  127.   125:   WriteLn('Sorting.');
  128.   126: 
  129.   127:   Megasort(TestArray^,TestArray^,TestArray^,1,KeyLen,ArrayLength);
  130.   128: 
  131.   129:   WriteLn('Writing output file.');
  132.   130: 
  133.   131:   FOR i := 1 TO ArrayLength DO
  134.   132:     WriteLn(outfile,TestArray^[i]^);
  135.   133: 
  136.   134:   Close(infile);
  137.   135:   Close(outfile);
  138.   136: 
  139.   137:   WriteLn('Done.');
  140.   138: 
  141.   139: END.
  142.  
  143.  
  144. Listing 2
  145.  
  146. Listing 2
  147.  
  148. {SORTDAT.PAS - generates sort data for MEGASORT testing}
  149. {861223 :2200}
  150.  
  151. VAR
  152.   i,j : Integer;
  153.   ir  : Real;
  154.   s : String[255];
  155.   t : Text[10000];
  156.   n : Real;
  157.   Itype : Char;
  158.   MaxLength : Integer;
  159.   Ran : Char;
  160.   RealTemp : Real;
  161.   IntTemp : Integer;
  162.   RealExp : ARRAY [-30..30] OF Real;
  163.   FName   : String[80];èBEGIN
  164.   RealExp[-30] := 1E-30;
  165.   FOR i := -29 TO 30 DO
  166.     RealExp[i] := RealExp[i-1]*10;
  167.   Write('Name of data file to be generated: ');
  168.   ReadLn(FName);
  169.   Write('Number of items to generate: ');
  170.   ReadLn(n);
  171.   Write('Type of items (R for real, I for integer, S for string): ');
  172.   ReadLn(Itype);
  173.   Itype := Upcase(Itype);
  174.  
  175.   IF Itype = 'S' THEN
  176.     BEGIN
  177.       Write('Maximum length of strings: ');
  178.       ReadLn(MaxLength);
  179.       Write('Random string length or all maximum length (R or M): ');
  180.       ReadLn(Ran);
  181.       Ran := Upcase(Ran);
  182.     END;
  183.  
  184.   Assign(t,Fname);
  185.   Rewrite(t);
  186.   ir := 1.0;
  187.   REPEAT
  188.     BEGIN
  189.       IF ir = 1000*int(ir/1000) THEN WriteLn(ir:10:0);
  190.       IF Itype = 'S' THEN
  191.         BEGIN
  192.           s := '';
  193.           IF Ran = 'R' THEN
  194.             FOR j := 1 TO random(MaxLength) DO
  195.               s := s + chr(random(64)+32)
  196.           ELSE
  197.             FOR j := 1 TO MaxLength DO
  198.               s := s + chr(random(64)+32);
  199.           WriteLn(t,s);
  200.         END
  201.       ELSE IF Itype = 'R' THEN
  202.         BEGIN
  203.           RealTemp := Random;
  204.           IF Random > 0.5 THEN
  205.             RealTemp := -RealTemp;
  206.           IntTemp := Random(30);
  207.           RealTemp := RealTemp * RealExp[IntTemp];
  208.           Str(RealTemp,s);
  209.           IF RealTemp > 0 THEN
  210.             s := copy(s,3,length(s))
  211.           ELSE
  212.             s := copy(s,2,length(s));
  213.           WriteLn(t,s);
  214.         END
  215.       ELSE IF Itype = 'I' THEN
  216.         BEGIN
  217.           IntTemp := Random(32767);è          IF Random >0.5 THEN
  218.             IntTemp := -IntTemp;
  219.           Str(IntTemp,s);
  220.           WriteLn(t,s);
  221.         END;
  222.     END;
  223.     ir := ir + 1.0;
  224.   UNTIL ir > n;
  225.   Close(t);
  226. END.
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.                                                     MEGAA.PAS page 3
  267.  
  268.